home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / VECTOR~1.CLS < prev    next >
Text File  |  1997-06-14  |  4KB  |  137 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CVectorBool"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Public Enum EErrorVectorBool
  13.     eeBaseVectorBool = 13280    ' CVectorBool
  14. End Enum
  15.  
  16. Private ai() As Long
  17. Private iLast As Long
  18. Private cChunk As Long
  19.  
  20. Private Sub Class_Initialize()
  21.     cChunk = 1     ' Default size (32 bits) can be overridden
  22.     ReDim Preserve ai(1 To cChunk) As Long
  23.     iLast = 1
  24. End Sub
  25.  
  26. ' Friend properties to make data structure accessible to walker
  27. Friend Property Get Vector(ByVal i As Long) As Boolean
  28.     BugAssert i > 0 And i <= iLast
  29.     ' Compute the array index for bit i
  30.     Dim iIndex As Long
  31.     iIndex = ((i - 1) \ 32) + 1
  32.     Vector = ai(iIndex) And MBytes.Power2(i Mod 32)
  33. End Property
  34.  
  35. ' NewEnum must have the procedure ID -4 in Procedure Attributes dialog
  36. ' Create a new data walker object and connect to it
  37. Public Function NewEnum() As IEnumVARIANT
  38. Attribute NewEnum.VB_UserMemId = -4
  39.     ' Create a new iterator object
  40.     Dim vectorwalker As CVectorBoolWalker
  41.     Set vectorwalker = New CVectorBoolWalker
  42.     ' Connect it with collection data
  43.     vectorwalker.Attach Me
  44.     ' Return it
  45.     Set NewEnum = vectorwalker.NewEnum
  46. End Function
  47.  
  48. ' Item is the default property
  49. Property Get Item(ByVal i As Long) As Boolean
  50. Attribute Item.VB_UserMemId = 0
  51.     BugAssert i > 0
  52.     ' Index might fall within the array bounds and still
  53.     ' be greater than iLast. If so, raise an error
  54.     If i > iLast Then ErrRaise eeOutOfBounds
  55.     ' Compute the array index for bit i
  56.     Dim iIndex As Long
  57.     iIndex = ((i - 1) \ 32) + 1
  58.     Item = ai(iIndex) And MBytes.Power2(i Mod 32)
  59. End Property
  60.  
  61. Property Let Item(ByVal i As Long, ByVal fItemA As Boolean)
  62.     BugAssert i > 0
  63.     On Error GoTo FailLetItem
  64.     ' Compute the array index for bit i
  65.     Dim iIndex As Long
  66.     iIndex = ((i - 1) \ 32) + 1
  67.     
  68.     If fItemA Then
  69.         ' Set bit i to True
  70.         ai(iIndex) = ai(iIndex) Or MBytes.Power2(i Mod 32)
  71.     Else
  72.         ' Set bit i to False
  73.         ai(iIndex) = ai(iIndex) And Not MBytes.Power2(i Mod 32)
  74.     End If
  75.     If i > iLast Then iLast = i
  76.     Exit Property
  77. FailLetItem:
  78.     If iIndex > UBound(ai) Then
  79.         ' ReDim array to the number of longs needed to
  80.         ' store i bits, plus cChunk longs
  81.         ReDim Preserve ai(1 To iIndex + cChunk) As Long
  82.         Resume      ' Try again
  83.     End If
  84.     ErrRaise Err.Number     ' Other VB error for client
  85. End Property
  86.  
  87. Property Get Last() As Long
  88.     Last = iLast
  89. End Property
  90. Property Let Last(iLastA As Long)
  91.     BugAssert iLastA > 0
  92.     ' Compute the array index for bit iLast
  93.     Dim iIndex As Long
  94.     iIndex = ((iLastA - 1) \ 32) + 1
  95.     ' ReDim array to the number of longs needed
  96.     ' to store iLast bits
  97.     ReDim Preserve ai(1 To iIndex) As Long
  98.     iLast = iLastA
  99. End Property
  100.  
  101. Property Get Chunk() As Long
  102.     ' Return chunk size as number of bits
  103.     Chunk = cChunk * 32
  104. End Property
  105. Property Let Chunk(cChunkA As Long)
  106.     BugAssert cChunkA > 0
  107.     ' Make max chunk size approximately 100 bits (3 * 32)
  108.     Const cMaxChunk = 3
  109.     ' Calculate the number of longs needed to store
  110.     ' cChunkA bits
  111.     Dim cLong As Long
  112.     cLong = ((cChunkA - 1) \ 32) + 1
  113.     ' Store chunk size as a count of longs
  114.     cChunk = IIf(cChunkA < cMaxChunk * 32, cLong, cMaxChunk)
  115. End Property
  116.  
  117. #If fComponent = 0 Then
  118. Private Sub ErrRaise(e As Long)
  119.     Dim sText As String, sSource As String
  120.     If e > 1000 Then
  121.         sSource = App.ExeName & ".VectorBool"
  122.         Select Case e
  123.         Case eeBaseVectorBool
  124.             BugAssert True
  125.        ' Case ee...
  126.        '     Add additional errors
  127.         End Select
  128.         Err.Raise COMError(e), sSource, sText
  129.     Else
  130.         ' Raise standard Visual Basic error
  131.         sSource = App.ExeName & ".VBError"
  132.         Err.Raise e, sSource
  133.     End If
  134. End Sub
  135. #End If
  136.  
  137.